home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / a-strsea.adb < prev    next >
Text File  |  1994-05-19  |  9KB  |  303 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                   A D A . S T R I N G S . S E A R C H                    --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.6 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. --  Note: This code is derived from the ADAR.CSH public domain Ada 83
  26. --  versions of the Appendix C string handling packages (code extracted
  27. --  from Ada.Strings.Fixed). A significant change is that we optimize the
  28. --  case of identity mappings for Count and Index, and also Index_Non_Blank
  29. --  is specialized (rather than using the general Index routine).
  30.  
  31.  
  32. with Ada.Characters;
  33.  
  34. package body Ada.Strings.Search is
  35.  
  36.    -----------------------
  37.    -- Local Subprograms --
  38.    -----------------------
  39.  
  40.    function Belongs
  41.      (Element : Character;
  42.       Set     : Maps.Character_Set;
  43.       Test    : Membership)
  44.       return    Boolean;
  45.    pragma Inline (Belongs);
  46.    --  Determines if the given element is in (Test = Inside) or not in
  47.    --  (Test = Outside) the given character set.
  48.  
  49.    -------------
  50.    -- Belongs --
  51.    -------------
  52.  
  53.    function Belongs
  54.      (Element : Character;
  55.       Set     : Maps.Character_Set;
  56.       Test    : Membership)
  57.       return    Boolean
  58.    is
  59.    begin
  60.       if Test = Inside then
  61.          return Element in Set'range and then Set (Element);
  62.       else
  63.          return Element not in Set'range or else not Set (Element);
  64.       end if;
  65.    end Belongs;
  66.  
  67.    -----------
  68.    -- Count --
  69.    -----------
  70.  
  71.    function Count
  72.      (Source   : in String;
  73.       Pattern  : in String;
  74.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  75.       return     Natural
  76.    is
  77.       N : Natural;
  78.       J : Natural;
  79.  
  80.    begin
  81.       --  Handle the case of non-identity mappings by creating a mapped
  82.       --  string and making a recursive call using the identity mapping
  83.       --  on this mapped string. We identify the identity mapping by the
  84.       --  fact that our standard representation for Identity is empty.
  85.  
  86.       if Mapping'Last >= Mapping'First then
  87.          declare
  88.             Mapped_Source : String (Source'range);
  89.  
  90.          begin
  91.             for J in Source'range loop
  92.                if Source (J) in Mapping'range then
  93.                   Mapped_Source (J) := Mapping (Source (J));
  94.                else
  95.                   Mapped_Source (J) := Source (J);
  96.                end if;
  97.             end loop;
  98.  
  99.             return Count (Mapped_Source, Pattern);
  100.          end;
  101.       end if;
  102.  
  103.       if Pattern = "" then
  104.          raise Pattern_Error;
  105.       end if;
  106.  
  107.       N := 0;
  108.       J := Source'First;
  109.  
  110.       while J <= Source'Last - (Pattern'Length - 1) loop
  111.          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
  112.             N := N + 1;
  113.             J := J + Pattern'Length;
  114.          else
  115.             J := J + 1;
  116.          end if;
  117.       end loop;
  118.  
  119.       return N;
  120.    end Count;
  121.  
  122.    function Count (Source : in String; Set : in Maps.Character_Set)
  123.      return Natural
  124.    is
  125.       N : Natural := 0;
  126.  
  127.    begin
  128.       for I in Source'range loop
  129.          if Source (I) in Set'range and then Set (Source (I)) then
  130.             N := N + 1;
  131.          end if;
  132.       end loop;
  133.  
  134.       return N;
  135.    end Count;
  136.  
  137.    ----------------
  138.    -- Find_Token --
  139.    ----------------
  140.  
  141.    procedure Find_Token
  142.      (Source : in String;
  143.       Set    : in Maps.Character_Set;
  144.       Test   : in Membership;
  145.       First  : out Positive;
  146.       Last   : out Natural)
  147.    is
  148.    begin
  149.       for I in Source'range loop
  150.          if Belongs (Source (I), Set, Test) then
  151.             First := I;
  152.  
  153.             for J in I + 1 .. Source'Last loop
  154.                if not Belongs (Source (J), Set, Test) then
  155.                   Last := J - 1;
  156.                   return;
  157.                end if;
  158.             end loop;
  159.  
  160.             --  Here if I indexes 1st char of token, and all chars
  161.             --  after I are in the token
  162.  
  163.             Last := Source'Last;
  164.             return;
  165.          end if;
  166.       end loop;
  167.  
  168.       --  Here if no token found
  169.  
  170.       First := Source'First;
  171.       Last  := 0;
  172.    end Find_Token;
  173.  
  174.    -----------
  175.    -- Index --
  176.    -----------
  177.  
  178.    function Index
  179.      (Source   : in String;
  180.       Pattern  : in String;
  181.       Going    : in Direction := Forward;
  182.       Mapping  : in Maps.Character_Mapping := Maps.Identity)
  183.       return     Natural
  184.    is
  185.       Cur_Index : Natural;
  186.  
  187.    begin
  188.       --  Handle the case of non-identity mappings by creating a mapped
  189.       --  string and making a recursive call using the identity mapping
  190.       --  on this mapped string. We identify the identity mapping by the
  191.       --  fact that our standard representation for Identity is empty.
  192.  
  193.       if Mapping'Last >= Mapping'First then
  194.          declare
  195.             Mapped_Source : String (Source'range);
  196.  
  197.          begin
  198.             for J in Source'range loop
  199.                if Source (J) in Mapping'range then
  200.                   Mapped_Source (J) := Mapping (Source (J));
  201.                else
  202.                   Mapped_Source (J) := Source (J);
  203.                end if;
  204.             end loop;
  205.  
  206.             return Index (Mapped_Source, Pattern, Going);
  207.          end;
  208.       end if;
  209.  
  210.       if Pattern = "" then
  211.          raise Pattern_Error;
  212.       end if;
  213.  
  214.       if Going = Forward then
  215.          for J in 1 .. Source'Length - Pattern'Length + 1 loop
  216.             Cur_Index := Source'First + J - 1;
  217.  
  218.             if Pattern =
  219.                     Source (Cur_Index .. Cur_Index + Pattern'Length - 1)
  220.             then
  221.                return Cur_Index;
  222.             end if;
  223.          end loop;
  224.  
  225.       else -- Going = Backward
  226.          for J in reverse 1 .. Source'Length - Pattern'Length + 1 loop
  227.             Cur_Index := Source'First + J - 1;
  228.  
  229.             if Pattern =
  230.                     Source (Cur_Index .. Cur_Index + Pattern'Length - 1)
  231.             then
  232.                return Cur_Index;
  233.             end if;
  234.          end loop;
  235.       end if;
  236.  
  237.       --  Fall through if no match found. Note that the loops are skipped
  238.       --  completely in the case of the pattern being longer than the source.
  239.  
  240.       return 0;
  241.    end Index;
  242.  
  243.    function Index
  244.      (Source : in String;
  245.       Set    : in Maps.Character_Set;
  246.       Test   : in Membership := Inside;
  247.       Going  : in Direction  := Forward)
  248.       return   Natural
  249.    is
  250.    begin
  251.       if Going = Forward then
  252.          for J in Source'range loop
  253.             if Belongs (Source (J), Set, Test) then
  254.                return J;
  255.             end if;
  256.          end loop;
  257.  
  258.       else -- Going = Backward
  259.          for J in reverse Source'range loop
  260.             if Belongs (Source (J), Set, Test) then
  261.                return J;
  262.             end if;
  263.          end loop;
  264.